\ armasm.part4 of 4 v1.0

public:

\ Control structure macros 
\ NOTE: All branch targets are 1 cell

: AHEAD, ( -- here )  HERE  DUP 8 + B, ;
: IF, ( -- here )  REVERSE AHEAD, ;
: THEN, ( targ -- )  HERE JOIN ;
: ELSE, ( targ -- here )  AHEAD, SWAP THEN, ;

' HERE alias BEGIN,
' B, alias AGAIN, ( targ -- )
: UNTIL, ( targ -- )  REVERSE B, ;
: WHILE, ( targ -- here targ )
  IF,  SWAP ;
: REPEAT, ( targ1 targ2 -- )
  AGAIN, THEN, ;

private:

\ Large immediate constants

: CONSTB ( con1. -- con2. op-field. )
   2DUP MINIMIZE       \  pack constant
   SWAP DROP SWAP  ( con.  n  conLo ) 
   FF AND SWAP             \ make byte
   2DUP  8 LSHIFT OR  \ make op-field
   >R  2* 0 SWAP      ( con1. con2. shift )
    DRROTATE  DXOR    \  new constant
   R> 0 ;    \ op-field is double-cell
 
: +CONSTB ( con1. -- con2. op-field. )
   MINIMIZE     \ pack constant
   >R                   \ preserve shift cnt
  2DUP DROP DUP  \ low cell of const
  100 AND IF    \ test ninth bit
      NEGATE FF AND  \ calc const byte
      0 OVER
      2400000.    \ SUB ?,#?
   ELSE  \ ninth bit is clear
      FF AND     
      DUP NEGATE S>D  ROT
      2800000.   \ ADD ?,#?
   THEN
   ( const. val1. val2 op. | R: shift )
   \ make op-field
   ROT R@  8 LSHIFT OR 0 DOR
              ( const. val1. op. | R: shift )
    \ make new constant
   -2ROT D+  R> 2* DRROTATE
    2SWAP ;  


defer NEXTB
: ADDING   ['] +CONSTB is NEXTB ;
: ORING   ['] CONSTB is NEXTB ;

: (#OP,) ( dest. const. op. -- )
   2SWAP
   BEGIN 2DUP OR WHILE 
   \ while constant non-zero
      NEXTB   ( dst. op. const. opfld. )
   \ we want: 
     ( dst. op. const. dst. dst. opfld. op. )   
      2>R 2>R 2OVER 2OVER
      2R> -2ROT  ( dst. op. con. dst. op. )
      2OVER 2SWAP 2R> 2SWAP  \ oof!
      (OP)   \ write instruction
   REPEAT
   2DROP 2DROP 2DROP ; 

\ #OP, generates 1-4 instructions to
\ op the given register and constant 
\ into the given destination .

: #OP, ( dest. src. const. op. -- )
   IMM    \ set immediate flag
   2SWAP 
   NEXTB ( dst. src. op. const. opfld. )
  -2ROT 2>R 2>R    \ save op. & const.
   2>R 2OVER 2SWAP 2R> 
   ( dst. dst. src. opfld.  | R: op. const. )
   2R@ (OP)    \ write first instruction
   2R> 2R> 2SWAP 
   (#OP,) ;  \ write following instructs

public:

: #ORR,  ORING  1800000. #OP,  ;
: #EOR,  ORING  0200000. #OP,  ;

: #ADD,  ( dest src const -- )   
  ADDING
  0. ( +CONSTB inserts opcode )
  #OP, ;

: #SUB,  DNEGATE #ADD, ;

: #AND,  ( dest. src. const. -- )  
  ORING  ?INVERT 
  IF  1C00000.  ELSE 0000000. THEN 
  #OP, ;

: #BIC,  DINVERT #AND, ;

\ #MOV, generates 1-4 MOV/MVN 
\ and ADD/SUB instructions to move
\ a constant into the given
\ destination 

: #MOV,  ( dest. const. -- )
  ORING
  ?INVERT 
   IF  3E00000.  ELSE 3A00000. THEN
   \ invert const and choose opcode
  2SWAP 
  NEXTB  ( dst. op. const. opfld. )
  2>R -2ROT 2>R 2DUP 2DUP
  ( const. dst. dst. dst. | R: opfld. op. ) 
  2R> 2R> 2SWAP
  (OP)      \ write first instruction
   2OVER OR   IF    \ if more constant
     2DUP 2ROT #ADD,    
     \ do rest of instructions
  ELSE
     2DROP 2DROP  \ drop dest. and 0.
  THEN ;

: #MVN,  DINVERT #MOV, ;

: SWI,
  F000000.  INST_MS 2@  DOR  DOR
  CODE, RESET ;